home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / WC.4TH < prev   
Text File  |  1994-10-30  |  6KB  |  258 lines
  1. \ Word count program
  2. \ Will count characters, words, lines, pages, and printing time for
  3. \ any file or file(s) in the current directory
  4. \ Program copyright (C) 1985 Thomas Almy.  All rights reserved.
  5. \ Permission is granted to registered users of Forthcmp to sell or distribute
  6. \ computer programs incorporating the compiled contents of this file.
  7.  
  8. 200 MSDOS
  9. INCLUDE DOS1
  10.  
  11. \ *** PRINTER CHARACTERISTICS FOR PRINTING PRINTER TIME *******
  12. \ *** MUST SET FOR YOUR PRINTER.  THESE ARE FOR EPSON FX-85 ***
  13.  
  14. 160 CONSTANT chars/sec    \ printing speed, ignoring line feed
  15. 66 CONSTANT lines/page  
  16. 6 CONSTANT lines/sec    \ slew rate for line feed
  17.  
  18. 0 0 IN/OUT
  19. : USAGE MESSAGES  CR  
  20.     ." USAGE: WC {filenames}" CR
  21.     ." Filenames may have * or ? wildcards." CR
  22.     ." File `-' means standard input." CR
  23.     ;
  24.  
  25.  
  26. 128 CONSTANT SCRATCH_BUF \ file block
  27.  
  28.  
  29. HCB INFILE
  30.  
  31. \ KEY -- FROM A FILE
  32.  
  33. \ We will blanket allocate memory from location 6000 for 55k
  34. \  to be used as a large file buffer.
  35.  
  36. 1024 55 *  CONSTANT INBUFSZ
  37. 6000 CONSTANT INBUFFER   \ PUT INPUT BUFFER IN HIGH MEMORY
  38. VARIABLE INBUFPTR
  39. VARIABLE INBUFEND  
  40.  
  41. : KEY  INBUFPTR @ INBUFEND @ = IF ( fetch block )
  42.      INFILE INBUFFER INBUFSZ FREAD ?DUP IF ( everything OK )
  43.             INBUFFER INBUFPTR !  INBUFFER + INBUFEND !
  44.      ELSE [CTRL] Z EXIT 
  45.      THEN
  46.     THEN
  47.     INBUFPTR @ C@ 127 AND
  48.    1 INBUFPTR +! ;
  49.  
  50.  
  51. \ DIRECTORY SEARCHING STUFF
  52.  
  53. VARIABLE NEXTITEM
  54.  
  55. \ We will take the program argument list and fake it as a
  56. \ line of keyboard input to make parsing easier.
  57. 0 0 IN/OUT
  58. : DODIR  ( -- )
  59.    SCRATCH_BUF COUNT >BUFFER  \ stuff arglist
  60.    NEXTITEM ON            \ force reading of next item
  61.    ;
  62.  
  63.  
  64. \ PRINT A VALUE, PRINT A TIME
  65.  
  66. 2 0 IN/OUT
  67. : .VAL  ( dvalue -- )   
  68.    <# #S #> 10 OVER - SPACES TYPE ;
  69.  
  70. 2 0 IN/OUT
  71. : .TIME  ( dtime -- )   
  72.   5 SPACES
  73.   60 MU/MOD 60 MU/MOD DROP
  74.   ?DUP IF . ." hr " THEN
  75.   ?DUP IF . ." min " THEN
  76.   ?DUP IF . ." sec " THEN ;
  77.  
  78. \ GOTO A NEW FILE
  79. 2VARIABLE NBYTES    
  80. 2VARIABLE TOTBYTES
  81. 2VARIABLE NWORDS    
  82. 2VARIABLE TOTWORDS
  83. 2VARIABLE NLINES    
  84. 2VARIABLE TOTLINES
  85. VARIABLE NPAGES     
  86. 2VARIABLE TOTPAGES
  87. VARIABLE PAGEPOS
  88.  
  89. HCB WILDFILE 
  90.  
  91. VARIABLE INFILEP
  92.  
  93. 1 0 IN/OUT 
  94. : PUTN ( character -- , put in string of INFILE )
  95.    INFILEP @ C! 1 INFILEP +! ;
  96.  
  97. VARIABLE /PNTR
  98. 0 0 IN/OUT
  99. : MAKE-FILENAME \ set up INFILE with path from WILDFILE and
  100.         \ file name from SCRATCH_BUF
  101.     INFILE 3 + INFILEP ! \ address of destination string
  102.     INFILEP @  /PNTR !  \ location of last slash 
  103.     WILDFILE HCB>N COUNT 0 ?DO COUNT DUP PUTN 
  104.         DUP [CHAR] \ = OVER [CHAR] / = OR SWAP [CHAR] : = OR IF
  105.             INFILEP @ /PNTR ! THEN 
  106.     LOOP
  107.     DROP ( wildfile pointer )
  108.     /PNTR @ INFILEP !    \ get rid of characters after last \
  109.     SCRATCH_BUF 30 + \ remainder of filename
  110.     BEGIN COUNT DUP WHILE PUTN REPEAT 2DROP
  111.     INFILEP @ INFILE 3 + - INFILE 2 + C! \ length
  112.     0 PUTN \ zero delimit string
  113.     ;
  114.  
  115. 0 0 IN/OUT
  116. : RESET-STUFF
  117.   0. NBYTES 2!
  118.   0. NWORDS 2!
  119.   0. NLINES 2!
  120.   1 NPAGES !        \ each file is always at least 1 page
  121.   INBUFEND @ INBUFPTR !  ( force first read )
  122.   ;
  123.  
  124. 0 1 IN/OUT 
  125. : NEW-FILE? ( -- success )
  126.   BEGIN NEXTITEM @ IF ( must scan input stream )
  127.         BL WORD DUP @ [CHAR] - 8 LSHIFT 1+ = IF ( use std-input )
  128.             DROP
  129.             C" (std-input)" INFILE NAME>HCB
  130.             stdin @ INFILE !
  131.             RESET-STUFF
  132.             -1
  133.             EXIT
  134.         THEN
  135.         DUP C@ 0= IF DROP 0 EXIT THEN ( End of line )
  136.         WILDFILE NAME>HCB
  137.         WILDFILE HCB>N 0 firstf
  138.         NEXTITEM OFF 
  139.     ELSE
  140.         nextf
  141.     THEN 
  142.     WHILE ( search failed )
  143.     NEXTITEM ON
  144.     REPEAT
  145.   MAKE-FILENAME
  146.   INFILE O_RD FOPEN IF CR 
  147.     ." OPEN FAILED FOR " INFILE .FNAME
  148.     NEW-FILE? EXIT THEN    \ recurse for additional files
  149.   RESET-STUFF
  150.   -1 ( SUCCESS! )   ;
  151.  
  152. \ PRINT TOTALS
  153. 2VARIABLE TOTTIME
  154. 0 0 IN/OUT
  155. : PRINT-TOTALS
  156.   NBYTES 2@ TOTBYTES 2@ D- D0= IF CR EXIT THEN
  157.   CR ." TOTALS--" 11 SPACES
  158.   TOTBYTES 2@ .VAL  
  159.   TOTWORDS 2@ .VAL
  160.   TOTLINES 2@ .VAL  
  161.   TOTPAGES 2@ .VAL
  162.   TOTTIME 2@ .TIME   
  163.   CR ;
  164.  
  165. 0 0 IN/OUT
  166. : PRINT-STATISTICS
  167.   CR INFILE .FNAME
  168.   19 INFILE HCB>N C@ - 0 MAX SPACES
  169.   NBYTES 2@  2DUP  .VAL      TOTBYTES 2@ D+  TOTBYTES 2!
  170.   NWORDS 2@  2DUP  .VAL      TOTWORDS 2@ D+  TOTWORDS 2!
  171.   NLINES 2@  2DUP  .VAL      TOTLINES 2@ D+  TOTLINES 2!
  172.   NPAGES @ 0 2DUP  .VAL      TOTPAGES 2@ D+  TOTPAGES 2!
  173.   NBYTES 2@  chars/sec  UM/MOD  NIP  0
  174.     NPAGES @  lines/page lines/sec / UM*
  175.     D+ ( total time )
  176.   2DUP  .TIME    TOTTIME 2@ D+  TOTTIME 2! ;
  177.  
  178.  
  179. \  COUNT THE FILE
  180. 1 0 IN/OUT
  181. \ : BUMP   DUP 2@ 1. D+ ROT 2! ;
  182. CODE BUMP  
  183.     AX BX MOV
  184.     1 # 2 +[BX] ADD
  185.     0 # [BX] ADC
  186.     RET
  187. END-CODE
  188.  
  189.  
  190. 0 0 IN/OUT
  191. : COUNT-FILE   PAGEPOS OFF
  192.     NBYTES BUMP
  193.     KEY ( prime the pump )
  194.     BEGIN  
  195.       BEGIN ( out of word loop )
  196.         DUP BL <= 
  197.       WHILE
  198.     CASE
  199.       [CTRL] L OF 1 NPAGES +! PAGEPOS OFF ENDOF
  200.       [CTRL] J OF NLINES BUMP 1 PAGEPOS +!
  201.         PAGEPOS @ 66 > IF 1 NPAGES +! PAGEPOS OFF THEN ENDOF
  202.       [CTRL] Z OF NBYTES 2@ 1. D- NBYTES 2! EXIT ENDOF ( done! )
  203.     ENDCASE
  204.         NBYTES BUMP  KEY
  205.       REPEAT
  206.       NWORDS BUMP ( entering a word )
  207.       BEGIN ( in word loop )
  208.         DUP BL >
  209.       WHILE
  210.         DROP
  211.     NBYTES BUMP
  212.     KEY
  213.       REPEAT
  214.     AGAIN
  215. ;
  216.  
  217.  
  218. \ CLOSE THE FILE
  219.  
  220. 0 0 IN/OUT
  221. : CLOSE-THE-FILE
  222.     INFILE HCB>H stdin <> IF
  223.         INFILE FCLOSE DROP
  224.     THEN ;
  225.  
  226. \ MESSAGES
  227. 0 0 IN/OUT
  228. : HELLO \ MESSAGES
  229. \  ." Word Count Program," CR
  230. \  ." Copyright (C) 1985 by Tom Almy" CR  CONSOLE
  231.   ." FILENAME                BYTES     WORDS     LINES     PAGES     TIME"  CR
  232.   0. TOTBYTES 2!  
  233.   0. TOTWORDS 2!  
  234.   0. TOTLINES 2!  
  235.   0. TOTPAGES 2!
  236.   0. TOTTIME  2!
  237. ;
  238.  
  239. : MAIN 
  240.     128 C@ 0= IF USAGE EXIT THEN
  241.     HELLO 
  242.     DODIR
  243.     BEGIN 
  244.       NEW-FILE? WHILE
  245.       COUNT-FILE
  246.       CLOSE-THE-FILE
  247.       PRINT-STATISTICS
  248.     REPEAT
  249.     PRINT-TOTALS
  250. ;
  251.  
  252.  
  253. INCLUDE DOS2
  254. INCLUDE FORTHLIB
  255.  
  256. END
  257.  
  258.